home *** CD-ROM | disk | FTP | other *** search
/ CD-ROM Data 2002 May / CD Rom Data Mayıs 2002.iso / Freeware / Blitz Basic / data1.cab / Support / help / samples / gravity.bb < prev    next >
Encoding:
Text File  |  2002-04-10  |  1.4 KB  |  80 lines

  1.  
  2.  
  3. ;Debug OFF for this beast!
  4.  
  5. ;
  6.  
  7. ;right-mouse zoom out, left-mouse zoom in.
  8.  
  9. ;
  10.  
  11. Const width=640,height=480
  12.  
  13. Const num_blobs=300,min_mass#=.01,max_mass#=.02
  14.  
  15.  
  16.  
  17. AppTitle "Gravity simulator"
  18.  
  19.  
  20.  
  21. Type Blob
  22.  
  23.     Field x#,y#,xs#,ys#,mass#,r,g,b
  24.  
  25. End Type
  26.  
  27.  
  28.  
  29. Graphics width,height
  30.  
  31. SetBuffer BackBuffer()
  32.  
  33.  
  34.  
  35. SetupBlobs()
  36.  
  37.  
  38.  
  39. Global scale#=1
  40.  
  41.  
  42.  
  43. While Not KeyDown(1)
  44.  
  45.     Cls
  46.  
  47.     If MouseHit(1)
  48.  
  49.         scale=scale*2
  50.  
  51.     Else If MouseHit(2)
  52.  
  53.         scale=scale/2
  54.  
  55.     EndIf
  56.  
  57.     Origin MouseX(),MouseY()
  58.  
  59.     time=MilliSecs()
  60.  
  61.     UpdateBlobs()
  62.  
  63.     Text 0,0,MilliSecs()-time
  64.  
  65.     RenderBlobs()
  66.  
  67.     Flip
  68.  
  69. Wend
  70.  
  71.  
  72.  
  73. End
  74.  
  75.  
  76.  
  77. Function SetupBlobs()
  78.  
  79.     For k=1 To num_blobs
  80.  
  81.         b.Blob=New Blob
  82.  
  83.         ty#=Rnd(1)
  84.  
  85.         ra#=ty*width
  86.  
  87.         an#=Rnd(360)
  88.  
  89.         ma#=Rnd(1)*(max_mass-min_mass)+min_mass
  90.  
  91.         
  92.  
  93.         b\x=Cos(an)*ra
  94.  
  95.         b\y=Sin(an)*ra
  96.  
  97.         b\xs=0:b\ys=0
  98.  
  99.         b\mass=ma
  100.  
  101.         t#=(ma-min_mass)/(max_mass-min_mass)*255
  102.  
  103.         b\r=t
  104.  
  105.         b\g=t
  106.  
  107.         b\b=255
  108.  
  109.     Next
  110.  
  111. End Function
  112.  
  113.  
  114.  
  115. Function UpdateBlobs()
  116.  
  117.     For b.Blob=Each Blob
  118.  
  119.         For t.Blob=Each Blob
  120.  
  121.             If t=b Then Exit
  122.  
  123.             dx#=b\x-t\x
  124.  
  125.             dy#=b\y-t\y
  126.  
  127.             sq#=1.0/(dx*dx+dy*dy)
  128.  
  129.             t\xs=t\xs+dx*(b\mass*sq)
  130.  
  131.             t\ys=t\ys+dy*(b\mass*sq)
  132.  
  133.             b\xs=b\xs-dx*(t\mass*sq)
  134.  
  135.             b\ys=b\ys-dy*(t\mass*sq)
  136.  
  137.         Next
  138.  
  139.     Next
  140.  
  141. End Function
  142.  
  143.  
  144.  
  145. Function RenderBlobs()
  146.  
  147.     For b.Blob=Each Blob
  148.  
  149.         b\x=b\x+b\xs
  150.  
  151.         b\y=b\y+b\ys
  152.  
  153.         Color b\r,b\g,b\b
  154.  
  155.         Rect b\x*scale-1,b\y*scale-1,3,3
  156.  
  157.     Next
  158.  
  159. End Function